SuperHack/SuperHack CD.bin/CODING/VBASIC/DBAPPMON.ZIP/FORM1.FRM

Visual Basic Form | 1995-09-08 | 6.6 KB | 205 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H00C0C0C0&
   Caption         =   "DBAppMon v1.2 Demo"
   ClientHeight    =   3960
   ClientLeft      =   1350
   ClientTop       =   3000
   ClientWidth     =   7650
   Height          =   4365
   Left            =   1290
   LinkTopic       =   "Form1"
   ScaleHeight     =   3960
   ScaleWidth      =   7650
   Top             =   2655
   Width           =   7770
   Begin CommandButton cmdHookF12
      BackColor       =   &H00C0C0C0&
      Caption         =   "Hook F1&2 + Shift"
      Height          =   375
      Left            =   2100
      TabIndex        =   7
      Top             =   3480
      Width           =   1605
   End
   Begin CommandButton cmdHookF11
      BackColor       =   &H00C0C0C0&
      Caption         =   "Hook F1&1 + Alt"
      Height          =   375
      Left            =   300
      TabIndex        =   6
      Top             =   3480
      Width           =   1605
   End
   Begin CommandButton cmdHelp
      BackColor       =   &H00C0C0C0&
      Caption         =   "&?"
      Height          =   372
      Left            =   6660
      TabIndex        =   5
      Top             =   3000
      Width           =   432
   End
   Begin CommandButton cmdNotepad
      BackColor       =   &H00C0C0C0&
      Caption         =   "&Notepad"
      Height          =   375
      Left            =   5280
      TabIndex        =   4
      Top             =   3000
      Width           =   1215
   End
   Begin CommandButton cmdTaskList
      BackColor       =   &H00C0C0C0&
      Caption         =   "Show all &tasks"
      Height          =   375
      Left            =   1740
      TabIndex        =   3
      Top             =   3000
      Width           =   1455
   End
   Begin CommandButton cmdModules
      BackColor       =   &H00C0C0C0&
      Caption         =   "Show all &modules"
      Height          =   375
      Left            =   3360
      TabIndex        =   2
      Top             =   3000
      Width           =   1755
   End
   Begin CommandButton cmdMonitor
      BackColor       =   &H00C0C0C0&
      Caption         =   "&Start monitor"
      Height          =   375
      Left            =   300
      TabIndex        =   1
      Top             =   3000
      Width           =   1275
   End
   Begin ListBox List1
      Height          =   2760
      Left            =   60
      TabIndex        =   0
      Top             =   60
      Width           =   7455
   End
   Begin DBAppMon DBAppMon1
      Left            =   60
      ModuleLookupName=   ""
      Top             =   2820
   End
Option Explicit
Sub AddToBox (x As String)
  If List1.ListCount > 100 Then List1.RemoveItem 0
  List1.AddItem Format$(Now, "HH:MM") + "  " + x
End Sub
Sub cmdHelp_Click ()
  Dim S As String
  S = "DBAppMon is able to monitor application and DLL "
  S = S + "startup and exit and generates VB events when "
  S = S + " this happens. It also has several properties "
  S = S + "for retrieving various information about loaded "
  S = S + "tasks and DLLs. Furthermore, there are properties for "
  S = S + "retrieving version info from executables. (To try this "
  S = S + "feature, double click a line in the list box containing "
  S = S + "a file name.) For more information, please refer to "
  S = S + """DBAPPMON.WRI.""" + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10)
  S = S + "DBAppMon was written by Dan Bystr
m." + Chr$(13) + Chr$(10)
  S = S + "e-mail: ""[e-mail]"""
  MsgBox S, 0, "About DBAppMon"
End Sub
Sub cmdHookF11_Click ()
  If DBAppMon1.HotKey(0) Then
    DBAppMon1.HotKey(0) = 0
    cmdHookF11.Caption = "Hook Alt+F1&1"
  Else
    DBAppMon1.HotKey(2) = &H47A&
    cmdHookF11.Caption = "Unhook Alt+F1&1"
  End If
End Sub
Sub cmdHookF12_Click ()
  If DBAppMon1.HotKey(1) Then
    DBAppMon1.HotKey(1) = 0
    cmdHookF12.Caption = "Hook Ctrl+F1&2"
  Else
    DBAppMon1.HotKey(1) = &HA7B&
    cmdHookF12.Caption = "Unhook Ctrl+F1&2"
  End If
End Sub
Sub cmdModules_Click ()
  Dim S As String
  Dim i As Integer, m As Integer
  List1.Clear
  S = DBAppMon1.AllModules
    m = Val(Mid$(S, i + 1))
    List1.AddItem MyHex(m) + " " + DBAppMon1.ModuleFileName(m) + "  Usage: " & DBAppMon1.ModuleUsage(m)
    i = InStr(i + 1, S, ",")
    If i = 0 Then Exit Do
  Loop
End Sub
Sub cmdMonitor_Click ()
  DBAppMon1.Monitor = Not DBAppMon1.Monitor
  If DBAppMon1.Monitor Then
    cmdMonitor.Caption = "&Stop monitor"
    List1.Clear
  Else
    cmdMonitor.Caption = "&Start monitor"
  End If
End Sub
Sub cmdNotepad_Click ()
  List1.AddItem "Returned from Shell function: " & MyHex(Shell("notepad.exe"))
End Sub
Sub cmdTaskList_Click ()
  Dim S As String
  Dim i As Integer, t As Integer
  List1.Clear
  S = DBAppMon1.AllTasks
    t = Val(Mid$(S, i + 1))
    List1.AddItem MyHex(t) + " " + DBAppMon1.TaskFileName(t) + "  Parent: " & MyHex(DBAppMon1.TaskParent(t))
    i = InStr(i + 1, S, ",")
    If i = 0 Then Exit Do
  Loop
End Sub
Sub DBAppMon1_AppExit (hTask As Integer, nExitCode As Integer)
  AddToBox "AppExit code= " & nExitCode & " (" & MyHex(hTask) & ")"
End Sub
Sub DBAppMon1_AppStart (hTask As Integer)
  AddToBox "AppStart (" & MyHex(hTask) & ") hInst: " & MyHex(DBAppMon1.TaskInstance(hTask)) & " " & DBAppMon1.TaskFileName(hTask) & "  Parent: " & MyHex(DBAppMon1.TaskParent(hTask))
End Sub
Sub DBAppMon1_DLLExit (hModule As Integer)
  AddToBox "DLLExit (" & MyHex(hModule) & ")"
End Sub
Sub DBAppMon1_DLLStart (hModule As Integer)
  AddToBox "DLLStart (" & MyHex(hModule) & ") " & DBAppMon1.ModuleFileName(hModule)
End Sub
Sub DBAppMon1_HotKey (KeyCode As Integer, KeyInfo As Integer)
  AddToBox "HotKey: " & Hex$(KeyCode) & " " & Hex$(KeyInfo)
End Sub
Sub Form_Load ()
  List1.AddItem "This application was started from " & DBAppMon1.TaskFileName(DBAppMon1.TaskParent(DBAppMon1.MyTask))
End Sub
Sub List1_DblClick ()
  Dim FN As String, i As Integer
  FN = List1.List(List1.ListIndex)
  i = InStr(FN, ":\")
  If i < 2 Then
    MsgBox "This line doesn't contain a file name!", 48
    Exit Sub
  End If
  FN = Mid$(FN, i - 1)
  i = InStr(FN, " ")
  If i Then FN = Left$(FN, i - 1)
  On Error Resume Next
  DBAppMon1.VerReadInfo = FN
  If Err Then
    MsgBox "The file """ + FN + """ doesn't contain any version info!", 48
    Exit Sub
  End If
  Form2.Show 1
  DBAppMon1.VerReadInfo = ""
End Sub
Function MyHex (ByVal h As Integer) As String
  MyHex = "$" + Right$("000" + Hex$(h), 4)
End Function